home *** CD-ROM | disk | FTP | other *** search
/ BCI NET 2 / BCI NET 2.iso / archives / programming / source / obrn-a_1.5_src.lha / oberon-a / source3.lha / Source / OC / OCPrefs.mod < prev    next >
Encoding:
Text File  |  1995-01-26  |  14.6 KB  |  514 lines
  1. (*************************************************************************
  2.  
  3.      $RCSfile: OCPrefs.mod $
  4.   Description: Preferences editor for OC.
  5.  
  6.    Created by: fjc (Frank Copeland)
  7.     $Revision: 1.3 $
  8.       $Author: fjc $
  9.         $Date: 1995/01/26 00:17:17 $
  10.  
  11.   Copyright © 1993-1994, Frank Copeland
  12.   This module forms part of the OC program
  13.   See OC.doc for conditions of use and distribution
  14.  
  15.   Log entries are at the end of the file.
  16.  
  17. *************************************************************************)
  18.  
  19. <* STANDARD- *>
  20.  
  21. MODULE OCPrefs;
  22.  
  23. IMPORT
  24.   SYS := SYSTEM, Kernel, Errors, e := Exec, u := Utility, d := Dos,
  25.   du := DosUtil, str := Strings, OCPrefsRev, OCM, s := OCPrefsStrings,
  26.   wb := Workbench, i := Icon;
  27.  
  28. CONST
  29.  
  30.   CopyrightStr = "Copyright © 1995 Frank Copeland\n";
  31.  
  32. (* -- Command line template and parsing ------------------------------- *)
  33.  
  34. CONST
  35.  
  36.   template =
  37.     "FROM,SAVE/S,SEARCH/K,"
  38.     "SYMPATH/K,OBJPATH/K,ERRPATH/K,"
  39.     "SYMEXT/K,OBJEXT/K,ERREXT/K,"
  40.     "VERBOSE/S,DEBUG/S,MAKEICONS/S,"
  41.     "QUIET/S,NODEBUG/S,NOICONS/S,"
  42.     "SET/K,CLEAR/K";
  43.  
  44.   template2 = "FILES/M";
  45.  
  46.   optFROM      = 0;
  47.   optSAVE      = 1;
  48.   optSEARCH    = 2;
  49.   optSYMPATH   = 3;
  50.   optOBJPATH   = 4;
  51.   optERRPATH   = 5;
  52.   optSYMEXT    = 6;
  53.   optOBJEXT    = 7;
  54.   optERREXT    = 8;
  55.   optVERBOSE   = 9;
  56.   optDEBUG     = 10;
  57.   optMAKEICONS = 11;
  58.   optQUIET     = 12;
  59.   optNODEBUG   = 13;
  60.   optNOICONS   = 14;
  61.   optSET       = 15;
  62.   optCLEAR     = 16;
  63.   optCount     = 17;
  64.  
  65. TYPE
  66.  
  67.   StringArray = POINTER [2] TO ARRAY MAX(INTEGER) OF e.LSTRPTR;
  68.  
  69. VAR
  70.  
  71.   rdArgs, rdArgs2 : d.RDArgsPtr;
  72.   args : ARRAY optCount OF SYS.LONGWORD;
  73.  
  74.   (* These are filled in by ParseArgs() *)
  75.  
  76.   from : e.LSTRPTR;
  77.   save : BOOLEAN;
  78.  
  79. (*
  80. ** Lock on starting directory when run from Workbench.
  81. *)
  82.  
  83. VAR
  84.   startDir : d.FileLockPtr;
  85.  
  86. (*
  87. ** Actual name that OCPrefs was run under
  88. *)
  89.  
  90. VAR
  91.   progName : ARRAY 256 OF CHAR;
  92.  
  93. (*
  94. ** Console I/O
  95. *)
  96.  
  97. (*------------------------------------*)
  98. PROCEDURE OutStr* ( string : ARRAY OF CHAR );
  99. <*$CopyArrays-*>
  100. BEGIN (* OutStr *)
  101.   du.HaltIfBreak ({d.ctrlC});
  102.   IF d.PutStr (string) = 0 THEN END;
  103. END OutStr;
  104.  
  105.  
  106. (*------------------------------------*)
  107. PROCEDURE OutChar* ( c : CHAR );
  108. BEGIN (* OutChar *)
  109.   du.HaltIfBreak ({d.ctrlC});
  110.   d.PrintF ("%lc", c)
  111. END OutChar;
  112.  
  113.  
  114. (*------------------------------------*)
  115. PROCEDURE OutLn*;
  116. BEGIN (* OutLn *)
  117.   OutChar ("\n")
  118. END OutLn;
  119.  
  120.  
  121. (*------------------------------------*)
  122. PROCEDURE OutStr0* ( n : LONGINT );
  123.   VAR string : e.LSTRPTR;
  124. BEGIN (* OutStr0 *)
  125.   du.HaltIfBreak ({d.ctrlC});
  126.   string := s.GetString (n);
  127.   IF d.PutStr (string^) = 0 THEN END;
  128. END OutStr0;
  129.  
  130.  
  131. (*------------------------------------*)
  132. PROCEDURE OutStr1* ( n : LONGINT; string : ARRAY OF CHAR );
  133.   VAR format : e.LSTRPTR;
  134. <*$CopyArrays-*>
  135. BEGIN (* OutStr1 *)
  136.   du.HaltIfBreak ({d.ctrlC});
  137.   format := s.GetString (n);
  138.   d.PrintF (format^, SYS.ADR (string));
  139. END OutStr1;
  140.  
  141.  
  142. (*------------------------------------*)
  143. PROCEDURE OutBool* ( b : BOOLEAN );
  144. BEGIN (* OutBool *)
  145.   IF b THEN OutStr ("TRUE")
  146.   ELSE OutStr ("FALSE")
  147.   END
  148. END OutBool;
  149.  
  150.  
  151. (*------------------------------------*)
  152. PROCEDURE* Cleanup (VAR rc : LONGINT);
  153.  
  154.   VAR oldDir : d.FileLockPtr;
  155.  
  156. BEGIN (* Cleanup *)
  157.   IF rdArgs # NIL THEN
  158.     d.FreeArgs (rdArgs);
  159.     d.FreeDosObject (d.rdArgs, rdArgs);
  160.     rdArgs := NIL
  161.   END;
  162.   IF rdArgs2 # NIL THEN
  163.     d.FreeDosObject (d.rdArgs, rdArgs2);
  164.     rdArgs2 := NIL
  165.   END;
  166.   s.CloseCatalog();
  167.   IF Kernel.fromWorkbench THEN oldDir := d.CurrentDir (startDir) END
  168. END Cleanup;
  169.  
  170. (*------------------------------------*)
  171. PROCEDURE Init ();
  172.  
  173. BEGIN (* Init *)
  174.   Kernel.SetCleanup (Cleanup);
  175.   s.OpenCatalog (NIL, "");
  176.  
  177.   rdArgs := d.AllocDosObjectTags (d.rdArgs, u.end);
  178.   rdArgs2 := d.AllocDosObjectTags (d.rdArgs, u.end);
  179.   IF (rdArgs = NIL) OR (rdArgs2 = NIL) THEN
  180.     OutStr0 (s.msg15); HALT (d.warn)
  181.   END;
  182.  
  183.   args [optFROM]      := NIL;
  184.   args [optSAVE]      := FALSE;
  185.   args [optSEARCH]    := NIL;
  186.   args [optSYMPATH]   := NIL;
  187.   args [optOBJPATH]   := NIL;
  188.   args [optERRPATH]   := NIL;
  189.   args [optSYMEXT]    := NIL;
  190.   args [optOBJEXT]    := NIL;
  191.   args [optERREXT]    := NIL;
  192.   args [optVERBOSE]   := FALSE;
  193.   args [optDEBUG]     := FALSE;
  194.   args [optMAKEICONS] := FALSE;
  195.   args [optQUIET]     := FALSE;
  196.   args [optNODEBUG]   := FALSE;
  197.   args [optNOICONS]   := FALSE;
  198.   args [optSET]       := NIL;
  199.   args [optCLEAR]     := NIL;
  200. END Init;
  201.  
  202. (*------------------------------------*)
  203. PROCEDURE CloneStr ( oldStr : e.LSTRPTR ) : e.LSTRPTR;
  204.   VAR newStr : e.LSTRPTR;
  205. BEGIN (* CloneStr *)
  206.   SYS.NEW (newStr, str.Length (oldStr^) + 1);
  207.   COPY (oldStr^, newStr^);
  208.   RETURN newStr
  209. END CloneStr;
  210.  
  211. (*------------------------------------*)
  212. PROCEDURE ParseArgs ();
  213.  
  214.   VAR
  215.     string : e.LSTRPTR; strings : StringArray;
  216.     i : INTEGER; ignore : BOOLEAN; ch : CHAR;
  217.     args2 : ARRAY 1 OF SYS.LONGWORD;
  218.     verbose, quiet, debug, nodebug, makeicons, noicons : BOOLEAN;
  219.  
  220.   (*------------------------------------*)
  221.   PROCEDURE ParseString (s, msg : ARRAY OF CHAR);
  222.  
  223.     VAR len : LONGINT; buffer : e.LSTRPTR;
  224.  
  225.   <*$CopyArrays-*>
  226.   BEGIN (* ParseString *)
  227.     len := str.Length (s) + 2;
  228.     SYS.NEW (buffer, len);
  229.     COPY (s, buffer^);
  230.     buffer [len-2] := "\n"; buffer [len-1] := 0X;
  231.     rdArgs2.source.buffer := buffer;
  232.     rdArgs2.source.length := len - 1;
  233.     rdArgs2.source.curChr := 0;
  234.     rdArgs2.daList := 0; rdArgs2.buffer := NIL; rdArgs2.bufSiz := 0;
  235.     rdArgs2.extHelp := NIL; rdArgs2.flags := {};
  236.     args2 [0] := NIL;
  237.     IF d.OldReadArgs (template2, args2, rdArgs2) = NIL THEN
  238.       ignore := d.PrintFault (d.IoErr(), msg);
  239.       HALT (d.warn)
  240.     END
  241.   END ParseString;
  242.  
  243. BEGIN (* ParseArgs *)
  244.   from := SYS.VAL (e.LSTRPTR, args [optFROM]);
  245.   IF from = NIL THEN ignore := OCM.LoadPrefs ("OC.prefs")
  246.   ELSE ignore := OCM.LoadPrefs (from^)
  247.   END;
  248.  
  249.   save := (SYS.VAL (LONGINT, args [optSAVE]) # 0);
  250.  
  251.   string := SYS.VAL (e.LSTRPTR, args [optSEARCH]);
  252.   IF string # NIL THEN
  253.     OCM.ClearSearchPaths();
  254.     ParseString (string^, " !! SYM");
  255.     strings := SYS.VAL (StringArray, args2 [0]);
  256.     IF strings # NIL THEN
  257.       i := 0;
  258.       WHILE strings [i] # NIL DO
  259.         string := strings [i];
  260.         OCM.AddSearchPath (CloneStr (string));
  261.         INC (i)
  262.       END;
  263.     END;
  264.     d.FreeArgs (rdArgs2)
  265.   END;
  266.  
  267.   string := SYS.VAL (e.LSTRPTR, args [optSYMPATH]);
  268.   IF string # NIL THEN COPY (string^, OCM.SymPath) END;
  269.   string := SYS.VAL (e.LSTRPTR, args [optOBJPATH]);
  270.   IF string # NIL THEN COPY (string^, OCM.ObjPath) END;
  271.   string := SYS.VAL (e.LSTRPTR, args [optERRPATH]);
  272.   IF string # NIL THEN COPY (string^, OCM.ErrPath) END;
  273.  
  274.   string := SYS.VAL (e.LSTRPTR, args [optSYMEXT]);
  275.   IF string # NIL THEN COPY (string^, OCM.SymExt) END;
  276.   string := SYS.VAL (e.LSTRPTR, args [optOBJEXT]);
  277.   IF string # NIL THEN COPY (string^, OCM.ObjExt) END;
  278.   string := SYS.VAL (e.LSTRPTR, args [optERREXT]);
  279.   IF string # NIL THEN COPY (string^, OCM.ErrExt) END;
  280.  
  281.   verbose := (SYS.VAL (LONGINT, args [optVERBOSE]) # 0);
  282.   quiet := (SYS.VAL (LONGINT, args [optQUIET]) # 0);
  283.   IF verbose & quiet THEN
  284.     OutStr0 (s.msg5);
  285.     HALT (d.warn)
  286.   ELSIF verbose THEN OCM.Verbose := TRUE
  287.   ELSIF quiet THEN OCM.Verbose := FALSE
  288.   END;
  289.  
  290.   debug := (SYS.VAL (LONGINT, args [optDEBUG]) # 0);
  291.   nodebug := (SYS.VAL (LONGINT, args [optNODEBUG]) # 0);
  292.   IF debug & nodebug THEN
  293.     OutStr0 (s.msg6);
  294.     HALT (d.warn)
  295.   ELSIF debug THEN OCM.Debug := TRUE
  296.   ELSIF nodebug THEN OCM.Debug := FALSE
  297.   END;
  298.  
  299.   makeicons := (SYS.VAL (LONGINT, args [optMAKEICONS]) # 0);
  300.   noicons := (SYS.VAL (LONGINT, args [optNOICONS]) # 0);
  301.   IF makeicons & noicons THEN
  302.     OutStr0 (s.msg7);
  303.     HALT (d.warn)
  304.   ELSIF makeicons THEN OCM.MakeIcons := TRUE
  305.   ELSIF noicons THEN OCM.MakeIcons := FALSE
  306.   END;
  307.  
  308.   string := SYS.VAL (e.LSTRPTR, args [optSET]);
  309.   IF string # NIL THEN COPY (string^, OCM.SetNames) END;
  310.   string := SYS.VAL (e.LSTRPTR, args [optCLEAR]);
  311.   IF string # NIL THEN COPY (string^, OCM.ClearNames) END;
  312. END ParseArgs;
  313.  
  314. (*------------------------------------*)
  315. PROCEDURE Main ();
  316.  
  317.   (*------------------------------------*)
  318.   PROCEDURE WbArgs ();
  319.  
  320.     VAR
  321.       wbStartup : wb.WBStartupPtr;
  322.       wbArg     : wb.WBArg;
  323.       diskObj   : wb.DiskObjectPtr;
  324.       toolTypes : wb.ToolTypePtr;
  325.       string    : e.LSTRPTR;
  326.  
  327.   BEGIN (* WbArgs *)
  328.     wbStartup := SYS.VAL (wb.WBStartupPtr, Kernel.WBenchMsg);
  329.     IF wbStartup.numArgs > 2 THEN OutStr0 (s.msg14); HALT (d.warn) END;
  330.  
  331.     COPY (wbStartup.argList [0].name^, progName);
  332.     wbArg := wbStartup.argList [wbStartup.numArgs-1];
  333.     startDir := d.CurrentDir (wbArg.lock);
  334.  
  335.     IF i.base # NIL THEN
  336.       (* Attempt to load the icon *)
  337.       diskObj := i.GetDiskObject (wbArg.name^);
  338.       IF diskObj # NIL THEN
  339.         toolTypes := diskObj.toolTypes;
  340.         string := i.FindToolType (toolTypes, "FROM");
  341.         IF string # NIL THEN args [optFROM] := CloneStr (string) END;
  342.         string := i.FindToolType (toolTypes, "SAVE");
  343.         IF string # NIL THEN args [optSAVE] := TRUE END;
  344.         string := i.FindToolType (toolTypes, "SEARCH");
  345.         IF string # NIL THEN args [optSEARCH] := CloneStr (string) END;
  346.         string := i.FindToolType (toolTypes, "SYMPATH");
  347.         IF string # NIL THEN args [optSYMPATH] := CloneStr (string) END;
  348.         string := i.FindToolType (toolTypes, "OBJPATH");
  349.         IF string # NIL THEN args [optOBJPATH] := CloneStr (string) END;
  350.         string := i.FindToolType (toolTypes, "ERRPATH");
  351.         IF string # NIL THEN args [optERRPATH] := CloneStr (string) END;
  352.         string := i.FindToolType (toolTypes, "SYMEXT");
  353.         IF string # NIL THEN args [optSYMEXT] := CloneStr (string) END;
  354.         string := i.FindToolType (toolTypes, "OBJEXT");
  355.         IF string # NIL THEN args [optOBJEXT] := CloneStr (string) END;
  356.         string := i.FindToolType (toolTypes, "ERREXT");
  357.         IF string # NIL THEN args [optERREXT] := CloneStr (string) END;
  358.         string := i.FindToolType (toolTypes, "VERBOSE");
  359.         IF string # NIL THEN args [optVERBOSE] := TRUE END;
  360.         string := i.FindToolType (toolTypes, "QUIET");
  361.         IF string # NIL THEN args [optQUIET] := TRUE END;
  362.         string := i.FindToolType (toolTypes, "DEBUG");
  363.         IF string # NIL THEN args [optDEBUG] := TRUE END;
  364.         string := i.FindToolType (toolTypes, "NODEBUG");
  365.         IF string # NIL THEN args [optNODEBUG] := TRUE END;
  366.         string := i.FindToolType (toolTypes, "MAKEICONS");
  367.         IF string # NIL THEN args [optMAKEICONS] := TRUE END;
  368.         string := i.FindToolType (toolTypes, "NOICONS");
  369.         IF string # NIL THEN args [optNOICONS] := TRUE END;
  370.         string := i.FindToolType (toolTypes, "SET");
  371.         IF string # NIL THEN args [optSET] := CloneStr (string) END;
  372.         string := i.FindToolType (toolTypes, "CLEAR");
  373.         IF string # NIL THEN args [optCLEAR] := CloneStr (string) END;
  374.  
  375.         i.FreeDiskObject (diskObj)
  376.       END
  377.     END;
  378.  
  379.     IF (SYS.VAL (LONGINT, args [optFROM]) = 0) & (wbStartup.numArgs = 2)
  380.     THEN
  381.       args [optFROM] := wbArg.name
  382.     END
  383.   END WbArgs;
  384.  
  385.   (*------------------------------------*)
  386.   PROCEDURE CliArgs ();
  387.     VAR ignore : BOOLEAN;
  388.   BEGIN (* CliArgs *)
  389.     ASSERT (d.GetProgramName (progName, LEN (progName)));
  390.     IF d.OldReadArgs (template, args, rdArgs) = NIL THEN
  391.       ignore := d.PrintFault (d.IoErr(), "");
  392.       HALT (d.warn)
  393.     END
  394.   END CliArgs;
  395.  
  396.   (*------------------------------------*)
  397.   PROCEDURE PrintPrefs;
  398.     VAR i : INTEGER;
  399.   BEGIN (* PrintPrefs *)
  400.     OutStr0 (s.msg8);
  401.     IF from = NIL THEN OutStr ("OC.prefs")
  402.     ELSE OutStr (from^)
  403.     END;
  404.     OutLn; OutLn;
  405.     OutStr0 (s.msg9);
  406.     IF OCM.pathx = 0 THEN
  407.       OutStr0 (s.msg10)
  408.     ELSE
  409.       FOR i := 0 TO OCM.pathx - 1 DO
  410.         OutChar (" "); OutStr (OCM.searchPath [i]^);
  411.       END
  412.     END;
  413.     OutLn;
  414.     OutStr ("SymPath ........: "); OutStr (OCM.SymPath); OutLn;
  415.     OutStr ("ObjPath ........: "); OutStr (OCM.ObjPath); OutLn;
  416.     OutStr ("ErrPath ........: "); OutStr (OCM.ErrPath); OutLn;
  417.     OutStr ("SymExt .........: "); OutStr (OCM.SymExt); OutLn;
  418.     OutStr ("ObjExt .........: "); OutStr (OCM.ObjExt); OutLn;
  419.     OutStr ("ErrExt .........: "); OutStr (OCM.ErrExt); OutLn;
  420.     OutStr ("Verbose ........: "); OutBool (OCM.Verbose); OutLn;
  421.     OutStr ("Debug ..........: "); OutBool (OCM.Debug); OutLn;
  422.     OutStr ("MakeIcons ......: "); OutBool (OCM.MakeIcons); OutLn;
  423.     OutStr ("Set ............: "); OutStr (OCM.SetNames); OutLn;
  424.     OutStr ("Clear ..........: "); OutStr (OCM.ClearNames); OutLn;
  425.     OutLn;
  426.   END PrintPrefs;
  427.  
  428.   (*------------------------------------*)
  429.   PROCEDURE MakeIcon ( file : ARRAY OF CHAR );
  430.  
  431.     CONST defPrefsIcon = "def_prefs";
  432.  
  433.     VAR
  434.       icon    : ARRAY 256 OF CHAR;
  435.       diskObj : wb.DiskObjectPtr;
  436.       oldTool : e.LSTRPTR;
  437.  
  438.   <*$CopyArrays-*>
  439.   BEGIN (* MakeIcon *)
  440.     ASSERT (i.base # NIL, 100);
  441.     COPY (file, icon); str.Append (".info", icon);
  442.     IF ~du.FileExists (icon) THEN
  443.       diskObj := i.GetDiskObject ("ENV:OCPrefs/def_prefs");
  444.       IF diskObj = NIL THEN diskObj := i.GetDefDiskObject (wb.project) END;
  445.       IF diskObj # NIL THEN
  446.         oldTool := diskObj.defaultTool;
  447.         diskObj.defaultTool := SYS.ADR (progName);
  448.         diskObj.currentX := wb.noIconPosition;
  449.         diskObj.currentY := wb.noIconPosition;
  450.         IF ~i.PutDiskObject (file, diskObj) THEN
  451.           IF d.PrintFault (d.IoErr(), "PutDiskObject") THEN END;
  452.           OutStr1 (s.msg16, icon)
  453.         END;
  454.         diskObj.defaultTool := oldTool;
  455.         i.FreeDiskObject (diskObj)
  456.       ELSE
  457.         IF d.PrintFault (d.IoErr(), "GetDiskObject") THEN END;
  458.         OutStr0 (s.msg17)
  459.       END
  460.     END
  461.   END MakeIcon;
  462.  
  463. BEGIN (* Main *)
  464.   OutStr (OCPrefsRev.vString);
  465.   OutStr (CopyrightStr);
  466.   OutStr0 (s.msg13);
  467.   OutLn;
  468.  
  469.   IF Kernel.fromWorkbench THEN WbArgs()
  470.   ELSE CliArgs()
  471.   END;
  472.   ParseArgs();
  473.   PrintPrefs();
  474.   IF save THEN
  475.     IF from = NIL THEN
  476.       IF OCM.SavePrefs ("OC.prefs") THEN OutStr1 (s.msg11, "OC.prefs")
  477.       ELSE OutStr1 (s.msg12, "OC.prefs")
  478.       END;
  479.       IF Kernel.fromWorkbench THEN MakeIcon ("OC.prefs") END
  480.     ELSE
  481.       IF OCM.SavePrefs (from^) THEN OutStr1 (s.msg11, from^)
  482.       ELSE OutStr1 (s.msg12, from^)
  483.       END;
  484.       IF Kernel.fromWorkbench THEN MakeIcon (from^) END
  485.     END
  486.   END;
  487. END Main;
  488.  
  489. BEGIN (* OCPrefs *)
  490.   ASSERT (e.SysBase.libNode.version >= 37);
  491.   Errors.Init;
  492.  
  493.   Init();
  494.   Main()
  495. END OCPrefs.
  496.  
  497. (***************************************************************************
  498.  
  499.   $Log: OCPrefs.mod $
  500. # Revision 1.3  1995/01/26  00:17:17  fjc
  501. # - Release 1.5
  502. #
  503. # Revision 1.2  1995/01/09  14:08:13  fjc
  504. # - Removed command line arguments for icon names.
  505. # - No longer checks for the existence of directories when
  506. #   parsing the command line.
  507. # - Added MakeIcon() to create icons for preferences files.
  508. # - Implemented Workbench arguments.
  509. #
  510. # Revision 1.1  1995/01/05  13:28:53  fjc
  511. # Initial revision
  512. #
  513. ***************************************************************************)
  514.